home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
SPADV.ZIP
/
EVALU.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-01-01
|
4KB
|
125 lines
unit Evalu;
interface
uses Crt,Globals,Graph,Title,Misc;
function Evaluation : integer;
procedure ShowHiScores (Score : integer);
procedure LoadHiScores;
procedure SaveHiScores;
implementation
(**** EVALUATION OF GAME ****)
function Evaluation : integer;
var Txt : Str80;
Score : integer;
begin
ClearDevice;
SetTextStyle (SmallFont,HorizDir,7); SetColor (1);
SetTextJustify (CenterText,CenterText);
OutTextXY (160,10,'MISSION EVALUATION');
TextSize (3,2,3,2); SetColor (2);
if Done then Txt := 'COMPLETED' else Txt := 'terminated';
OutTextXY (160,40,'Mission '+Txt+' - '+
St(Ord(Done)*1000*Skill)+' points');
OutTextXY (160,55,'250x Crystals collected : '+St(Crystals));
OutTextXY (160,70,'100x Androids killed : '+St(RobotsKilled));
OutTextXY (160,85,'50x Electr. Keys carried : '+St(Keys));
OutTextXY (160,100,'10x Rooms visited : '+St(Rooms)+' of 90');
OutTextXY (160,115,'-10x Power packs used : '+St(PpacksUsed));
Score := (RobotsKilled * 100) - (PpacksUsed * 10) + (Crystals * 250) +
(Keys * 50) + (Rooms * 10) + (Ord (Done) * 1000 * Skill);
SetColor (1); SetLineStyle (DashedLn,1,ThickWidth); Line (0,137,319,137);
SetLineStyle (0,0,3); SetColor (3);
OutTextXY (160,150,'TOTAL SCORE : '+St(Score)+' points');
SetColor (2);
OutTextXY (160,180,'Press any key for Hi-Scores...');
while KeyPressed do K1:=ReadKey;
K1 := ReadKey;
Evaluation := Score;
end;
(**** HI-SCORE PROCESSING ****)
procedure ShowHiScores (Score : integer);
var Number,Ctr,Ps,
Sx,Sy : word;
Key : char;
begin
ClearDevice;
TextSize (4,3,3,1);
SetColor (1);
OutTextXY (160,7,'INTERGALACTIC SPACE WARRIORS OF ALL TIMES');
Number := 0;
if Score >= HiScore [MaxHiScores].Hscore then begin
repeat Inc (Number);
until Score >= HiScore [Number].Hscore;
for Ctr := MaxHiScores-1 downto Number do
HiScore [Ctr+1] := HiScore [Ctr];
with HiScore [Number] do begin
Hscore := Score;
Hdone := Done;
TextSize (3,2,3,2); SetColor (3);
OutTextXY (160,60,'Congratulations !!');
OutTextXY (160,75,'You have entered the hall of fame !');
Play ('t120 o4 l16 ceg>c8<g>c4');
SetColor (2);
OutTextXY (160,100,'Please enter your name below :');
TextSize (2,1,3,1); SetColor (1);
Hname := ''; Ps := 1;
repeat { Get player's name in BIG text }
Key := ReadKey;
SetColor (0);
OutTextXY (160,140,Hname);
case Key of
#32..#126 : if Length (Hname) < 16 then Hname := Hname + Key;
#8 : if Length (Hname) > 0 then Dec (Hname [0]);
end;
SetColor (1);
OutTextXY (160,140,Hname);
until (Key = #13);
end;
end;
Black (0,50,319,199);
SetTextJustify (LeftText,TopText);
TextSize (1,1,1,1);
for Ctr := 1 to MaxHiscores do begin { Write hiscores in two columns }
SetColor (2);
if Ctr = Number then SetColor (3);
Sx := 8 + Ord (Ctr>20) *160;
Sy := 37 + ((Ctr-1) mod 20) *8;
OutTextXY (Sx,Sy,St(Ctr)+')');
with HiScore [Ctr] do begin
OutTextXY (Sx+20,Sy,Hname);
OutTextXY (Sx+120,Sy,St(Hscore));
end;
end;
TextSize (6,4,1,1); SetColor (3);
SetTextJustify (CenterText,CenterText);
OutTextXY (160,27,'Last score : '+St(Score)+'. Press any key...');
while KeyPressed do K1 := ReadKey;
Key := ReadKey;
end;
procedure LoadHiScores;
var Number : word;
begin
if Exist ('HISC.DAT') then begin
Assign (HiScoreFile,'HISC.DAT');
Reset (HiScoreFile);
Read (HiScoreFile,HiScore);
end else for Number := 1 to MaxHiScores do with HiScore [Number] do begin
if (Number mod 2) > 0 then Hname := 'Robert Schmidt' { If no file }
else Hname := 'FireBall Ltd.'; { exists }
Hscore := (MaxHiscores-Number+1) * 50; { Scores are easy to beat }
Hdone := False;
end;
end;
procedure SaveHiScores;
begin
Assign (HiScoreFile,'HISC.DAT');
ReWrite (HiScoreFile);
Write (HiScoreFile,HiScore);
end;
end.